home *** CD-ROM | disk | FTP | other *** search
/ Delphi Programmer's Power Pack / Delphi Volume 1.iso / e_to_l / isamexpt / numctrl.pas < prev    next >
Pascal/Delphi Source File  |  1996-09-15  |  18KB  |  688 lines
  1. unit NumCtrl;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, Menus, DsgnIntF;
  8.  
  9. { string edit component }
  10. type
  11.   TCustomStrEdit = class (TCustomEdit)
  12.   private
  13.     FAlignment: TAlignment;
  14.     FOldAlignment : TAlignment;
  15.     FTextMargin : integer;
  16.     FRightNull  : Boolean;
  17.     function CalcTextMargin : integer;
  18.     procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
  19.     procedure CMExit(var Message: TCMExit);   message CM_EXIT;
  20.     procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  21.     procedure SetAlignment(Value: TAlignment);
  22.   protected
  23.     property Alignment: TAlignment read FAlignment write SetAlignment default taRightJustify;
  24.     property RightNull: Boolean read FRightNull write FRightNull default False;
  25.     procedure FormatText; dynamic;
  26.     procedure UnFormatText; dynamic;
  27.   public
  28.     constructor Create(AOwner: TComponent); override;
  29.   end;
  30.  
  31.   TStrEdit = class (TCustomStrEdit)
  32.   published
  33.     property Alignment;
  34.     property AutoSize;
  35.     property BorderStyle;
  36.     property CharCase; {KB}
  37.     property Color;
  38.     property Ctl3D;
  39.     property DragCursor;
  40.     property DragMode;
  41.     property Enabled;
  42.     property Font;
  43.     property HideSelection;
  44.     property MaxLength;
  45.     property ParentColor;
  46.     property ParentCtl3D;
  47.     property ParentFont;
  48.     property ParentShowHint;
  49.     property PopupMenu;
  50.     property ReadOnly;
  51.     property RightNull; {KB}
  52.     property ShowHint;
  53.     property TabOrder;
  54.     property Visible;
  55.     property OnChange;
  56.     property OnClick;
  57.     property OnDblClick;
  58.     property OnDragDrop;
  59.     property OnDragOver;
  60.     property OnEndDrag;
  61.     property OnEnter;
  62.     property OnExit;
  63.     property OnKeyDown;
  64.     property OnKeyPress;
  65.     property OnKeyUp;
  66.     property OnMouseDown;
  67.     property OnMouseMove;
  68.     property OnMouseUp;
  69.   end;
  70.  
  71. type
  72.   TNumericType = (ntGeneral, ntCurrency, ntPercentage);
  73.   TMaskString = string [25];
  74.  
  75. { mask component }
  76. type
  77.   TMasks = class (TPersistent)
  78.   private
  79.     FPositiveMask : TMaskString;
  80.     FNegativeMask : TMaskString;
  81.     FZeroMask : TMaskString;
  82.     FOnChange: TNotifyEvent;
  83.   protected
  84.     procedure SetPositiveMask (Value : TMaskString);
  85.     procedure SetNegativeMask (Value : TMaskString);
  86.     procedure SetZeroMask (Value : TMaskString);
  87.   public
  88.     constructor Create;
  89.     property OnChange: TNotifyEvent read FOnChange write FOnChange;
  90.   published
  91.     property PositiveMask : TMaskString read FPositiveMask write SetPositiveMask;
  92.     property NegativeMask : TMaskString read FNegativeMask write SetNegativeMask;
  93.     property ZeroMask : TMaskString read FZeroMask write SetZeroMask;
  94.   end;
  95.  
  96. { num edit component }
  97. type
  98.   TCustomNumEdit = class (TCustomStrEdit)
  99.   private
  100.     FDecimals : word;
  101.     FDigits : word;
  102.     FMasks : TMasks;
  103.     FMax : extended;
  104.     FMin : extended;
  105.     FNumericType : TNumericType;
  106.     FUseRounding : boolean;
  107.     FValue : extended;
  108.     FValidate : boolean;
  109.     procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
  110.     procedure CMExit(var Message: TCMExit);   message CM_EXIT;
  111.     procedure SetDecimals(Value : word);
  112.     procedure SetDigits(Value : word);
  113.     procedure SetMasks (Mask : TMasks);
  114.     procedure SetMax(Value : extended);
  115.     procedure SetMin(Value : extended);
  116.     procedure SetNumericType(Value : TNumericType);
  117.     procedure SetValue(Value : extended);
  118.     procedure SetValidate(Value : boolean);
  119.   protected
  120.     procedure FormatText; dynamic;
  121.     procedure KeyPress(var Key: Char); override;
  122.     procedure UnFormatText; dynamic;
  123.     property Decimals : word read FDecimals write SetDecimals;
  124.     property Digits : word read FDigits write SetDigits;
  125.     property Masks : TMasks read FMasks write SetMasks;
  126.     property Max : extended read FMax write SetMax;
  127.     property Min : extended read FMin write SetMin;
  128.     property NumericType : TNumericType read FNumericType write SetNumericType default ntCurrency;
  129.     property UseRounding : boolean read FUseRounding write FUseRounding;
  130.     property Value : extended read FValue write SetValue;
  131.     property Validate : boolean read FValidate write SetValidate;
  132.   public
  133.     constructor Create(AOwner: TComponent); override;
  134.     destructor Destroy; override;
  135.     function AsDouble : double; dynamic;
  136.     function AsInteger : integer; dynamic;
  137.     function AsLongint : longint; dynamic;
  138.     function AsReal : real; dynamic;
  139.     function AsString : string; dynamic;
  140.     procedure MaskChanged ( Sender : TObject );
  141.     function Valid ( Value : extended ) : boolean; dynamic;
  142.   end;
  143.  
  144.   TNumEdit = class (TCustomNumEdit)
  145.   published
  146.     property AutoSize;
  147.     property BorderStyle;
  148.     property Color;
  149.     property Ctl3D;
  150.     property Decimals;
  151.     property Digits;
  152.     property DragCursor;
  153.     property DragMode;
  154.     property Enabled;
  155.     property Font;
  156.     property HideSelection;
  157.     property Masks;
  158.     property Max;
  159.     property Min;
  160.     property NumericType;
  161.     property ParentColor;
  162.     property ParentCtl3D;
  163.     property ParentFont;
  164.     property ParentShowHint;
  165.     property PopupMenu;
  166.     property ReadOnly;
  167.     property ShowHint;
  168.     property TabOrder;
  169.     property UseRounding;
  170.     property Value;
  171.     property Validate;
  172.     property Visible;
  173.     property OnChange;
  174.     property OnClick;
  175.     property OnDblClick;
  176.     property OnDragDrop;
  177.     property OnDragOver;
  178.     property OnEndDrag;
  179.     property OnEnter;
  180.     property OnExit;
  181.     property OnKeyDown;
  182.     property OnKeyPress;
  183.     property OnKeyUp;
  184.     property OnMouseDown;
  185.     property OnMouseMove;
  186.     property OnMouseUp;
  187.   end;
  188.  
  189. implementation
  190.  
  191. type
  192.   TSetOfChar = set of char;
  193. var
  194.   OldMaxLength : integer;
  195.  
  196. {========================================================================}
  197. { support routines                                                       }
  198. {========================================================================}
  199.  
  200. function Power ( X, Y : integer ) : real;
  201. begin
  202.   Result := exp ( ln ( X ) * Y );
  203. end;
  204.  
  205. function StripChars ( const Text : string; ValidChars : TSetOfChar ) : string;
  206. var
  207.   S : string;
  208.   i : integer;
  209.   Negative : boolean;
  210. Begin
  211.   Negative := false;
  212.   if (Text [ 1 ] = '-') or (Text [length (Text)] = '-' ) then
  213.     Negative := true;
  214.   S := '';
  215.   for i := 1 to length ( Text ) do
  216.     if Text [ i ] in ValidChars then
  217.       S := S + Text [ i ];
  218.   if Negative then
  219.     Result := '-' + S
  220.   else
  221.     Result := S;
  222. End;
  223.  
  224. {========================================================================}
  225. { Custom String Edit                                                     }
  226. {========================================================================}
  227.  
  228. constructor TCustomStrEdit.Create(AOwner: TComponent);
  229. begin
  230.   inherited Create(AOwner);
  231.   FAlignment := taLeftJustify;
  232.   FTextMargin := CalcTextMargin;
  233. end;
  234.  
  235. function TCustomStrEdit.CalcTextMargin : integer;
  236. {borrowed from TDBEdit}
  237. {calculates a pixel offset from the edge of the control to the text(a margin)}
  238. {used in the paint routine}
  239. var
  240.   DC: HDC;
  241.   SaveFont: HFont;
  242.   I: Integer;
  243.   SysMetrics, Metrics: TTextMetric;
  244. begin
  245.   DC := GetDC(0);
  246.   GetTextMetrics(DC, SysMetrics);
  247.   SaveFont := SelectObject(DC, Font.Handle);
  248.   GetTextMetrics(DC, Metrics);
  249.   SelectObject(DC, SaveFont);
  250.   ReleaseDC(0, DC);
  251.   I := SysMetrics.tmHeight;
  252.   if I > Metrics.tmHeight then
  253.     I := Metrics.tmHeight;
  254.   Result := I div 4;
  255. end;
  256.  
  257. procedure TCustomStrEdit.SetAlignment(Value: TAlignment);
  258. begin
  259.   if FAlignment <> Value then
  260.     begin
  261.     FAlignment := Value;
  262.     Invalidate;
  263.     end;
  264. end;
  265.  
  266. procedure TCustomStrEdit.CMEnter(var Message: TCMEnter);
  267. begin
  268.   if FRightNull then UnformatText;
  269.   inherited;
  270.   FOldAlignment := FAlignment;
  271.   Alignment := taLeftJustify;
  272. end;
  273.  
  274. procedure TCustomStrEdit.CMExit(var Message: TCMExit);
  275. begin
  276.   if FRightNull then FormatText;
  277.   inherited;
  278.   Alignment := FOldAlignment;
  279. end;
  280.  
  281. Procedure TCustomStrEdit.UnformatText;
  282. begin
  283.   Text := StripChars ( Text, [ '0'..'9', Decima